home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Tutorial Material / Pitch and Rhythm Tutorial / Rhythm Template drms < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  93 lines
  1. ; Study in rhythmic construction #7a
  2.  
  3. (setq mel1 
  4.     (symbol-transform
  5.         from '(a b c d)
  6.         to '(e f g h)
  7.         order '(0 3 2 1)
  8.         changes '(1)
  9.         repeats '(1 2 3)
  10.      )
  11. )
  12.  
  13. (setq mel2 
  14.     (symbol-transform
  15.         from '(e f g h)
  16.         to '(i j k l)
  17.         order '(3 2 1 0)
  18.         changes '(1)
  19.         repeats '(1 2 3)
  20.     )
  21. )
  22.  
  23. (setq mel3 
  24.     (symbol-transform
  25.         from '(i j k l)
  26.         to '(a b c d)
  27.         order  '(2 1 0 3)
  28.         changes '(1)
  29.         repeats '(1 2 3)
  30.     )
  31. )
  32.  
  33. (setq mel4 
  34.     (symbol-transform
  35.         from '(m n o p)
  36.         to '(e f g h)
  37.         order '(1 0 3 2)
  38.         changes '(1)
  39.         repeats '(1 2 3)
  40.     )
  41. )
  42.  
  43. (def-neuron make-rhythm1
  44.  (in 1 'a) '1/4
  45.  (in 1 'b) '(1/8 1/8)
  46.  (in 1 'c) '(-1/8 1/8)
  47.  (in 1 'd) '(1/16 1/8 1/16)
  48.  (in 1 'e) '(1/16 1/16 1/16 1/16)
  49.  (in 1 'f) '(1/8 1/16 1/16)
  50.  (in 1 'g) '(1/16 1/16 1/8)
  51.  (in 1 'h) '(-1/8 1/16 1/16)
  52.  (in 1 'i) '(1/16 1/16 -1/8)
  53.  (in 1 'j) '(1/16 1/16 -1/16 1/16)
  54.  (in 1 'k) '(1/16 1/16 1/16 1/16)
  55.  (in 1 'l) '(1/16 -1/16 -1/16 1/16)
  56.  (in 1 'm) '(-1/16 1/16 1/16 -1/16)
  57.  (in 1 'n) '(-1/16 -1/16 -1/16 1/16)
  58.  (in 1 'o) '(-1/16 1/16 -1/16 -1/16)
  59.  (in 1 'p) '(-1/16 1/16 -1/16 1/16)
  60.  (in 1 'q) '(1/8t 1/8t 1/8t)
  61.  (in 1 'r) '(1/4t 1/8t)
  62.  (in 1 's) '(1/8t 1/4t)
  63.  (in 1 't) '(1/16t 1/16t 1/16t 1/16t 1/16t 1/16t) 
  64.  (in 1 'u) '(1/4t 1/4t 1/4t)
  65.  (otherwise '(1/32 1/32 1/32 1/32 1/32 1/32 1/32 1/32))
  66. )
  67.  
  68. (setq mels (append mel1 mel2 mel3 mel4))
  69.  
  70. (def-symbol
  71.   bass mels
  72.   drums (filter-extract '(a b c h i) mels)
  73. ) 
  74.  
  75. (def-expression
  76.   default ((legato 80 19 0.7) (humanize 0 2 0.6) (velocity 30 0.5))
  77. )
  78.  
  79. (def-length
  80.   bass (run-neuron 'make-rhythm1
  81.                    (append mel4 mel3 mel2 mel1))
  82.   drums (run-neuron 'make-rhythm1
  83.                     (append mel4 mel3 mel2 mel1))
  84. )
  85.  
  86. (setq tonal (activate-tonality (chromatic g 3)))
  87.  
  88. (compile-song-p "ccl;output:" 1/1 "duo"
  89. ; BARS            |---|---|---|---|---|---|---|---|
  90. bass      tonal  "--------------------------------"
  91. drums     mt-32  "------------------------------- "
  92. )
  93.